home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 51 / Amiga Format CD51 (2000-03-10)(Future Publishing)(GB)[!][issue 2000-04].iso / -serious- / programming / e / powerd / source / fd2m.e < prev    next >
Text File  |  2000-01-27  |  4KB  |  157 lines
  1. OPT OSVERSION=37
  2.  
  3. ENUM    T_VOID,T_PTR_TO_CHAR,T_PTR_TO_TagItem
  4.  
  5. PROC main()
  6.     DEF myargs:PTR TO LONG,rdargs,dest[256]:STRING,src[256]:STRING
  7.     myargs:=[NIL]
  8.     IF rdargs:=ReadArgs('SOURCE/A',myargs,NIL)
  9.         StringF(src,'\s.fd',myargs[0])
  10.         StringF(dest,'\s.m',myargs[0])
  11.         xConvert(src,dest)
  12.         FreeArgs(rdargs)
  13.     ELSE
  14.         PrintFault(IoErr(),'fd2m')
  15.     ENDIF
  16. ENDPROC
  17.  
  18. PROC xConvert(src:PTR TO CHAR,dst:PTR TO CHAR)
  19.     DEF s,d,m,l
  20.     IF s:=Open(src,OLDFILE)
  21.         IF d:=Open(dst,NEWFILE)
  22.             IF m:=New(l:=FileLength(src))
  23.                 Read(s,m,l)
  24.                 xProcess(d,m,l)
  25.                 Dispose(m)
  26.             ENDIF
  27.             Close(d)
  28.         ELSE
  29.             PrintFault(IoErr(),'fd2m')
  30.         ENDIF
  31.         Close(s)
  32.     ELSE
  33.         PrintFault(IoErr(),'fd2m')
  34.     ENDIF
  35. ENDPROC
  36.  
  37. PROC xProcess(o,src:PTR TO CHAR,length)
  38.     DEF pos=0,offset,public,name[256]:STRING,l,next,nofirst
  39.     DEF argtype[16]:ARRAY OF CHAR,p,q
  40.     WHILE pos<length
  41.         IF src[pos]="*"
  42.             pos:=xNextLine(src,pos,length)
  43.         ELSEIF And(src[pos]="#",src[pos+1]="#")
  44.             WriteF('##\d\n',pos)
  45.             pos:=pos+2
  46.             IF StrCmp(src+pos,'base',4)
  47.                 VfPrintf(o,'LIBRARY ',NIL)
  48.                 nofirst:=FALSE
  49.                 Flush(o)
  50.                 Write(o,src+pos+6,xWordLength(src,pos+6,length))
  51.                 pos:=xNextLine(src,pos,length)
  52.             ELSEIF StrCmp(src+pos,'bias',4)
  53.                 offset:=Val(src+pos+5)
  54.                 pos:=xNextLine(src,pos,length)
  55.             ELSEIF StrCmp(src+pos,'public',6)
  56.                 public:=TRUE
  57.                 pos:=xNextLine(src,pos,length)
  58.             ELSEIF StrCmp(src+pos,'private',7)
  59.                 public:=FALSE
  60.                 pos:=xNextLine(src,pos,length)
  61.             ELSEIF StrCmp(src+pos,'end',3)
  62.                 RETURN
  63.             ENDIF
  64.         ELSE
  65. ->            WriteF('\d\n',pos)
  66.             IF public
  67.                 StrCopy(name,src+pos,l:=xWordLength(src,pos,length))
  68.                 pos++                                -> skip "("
  69.                 IF nofirst THEN VfPrintf(o,',',NIL)
  70.                 nofirst:=TRUE
  71.                 VfPrintf(o,'\n\t\s(',[name])
  72.                 p:=0
  73.                 WHILE src[pos]<>")"
  74.                     argtype[p]:=T_VOID
  75.                     IF StrCmp(src+pos,'title',STRLEN)
  76.                         argtype[p]:=T_PTR_TO_CHAR
  77.                         q:=5
  78.                     ELSEIF StrCmp(src+pos,'name',STRLEN)
  79.                         argtype[p]:=T_PTR_TO_CHAR
  80.                         q:=4
  81.                     ELSEIF StrCmp(src+pos,'text',STRLEN)
  82.                         argtype[p]:=T_PTR_TO_CHAR
  83.                         q:=4
  84.                     ELSEIF StrCmp(src+pos,'tags',STRLEN)
  85.                         argtype[p]:=T_PTR_TO_TagItem
  86.                         q:=4
  87.                     ELSEIF StrCmp(src+pos,'taglist',STRLEN)
  88.                         q:=7
  89.                         argtype[p]:=T_PTR_TO_TagItem
  90.                ELSE
  91.                         REPEAT
  92.                             pos++
  93.                         UNTIL Or(src[pos]=",",src[pos]=")")
  94.                         q:=0
  95.                     ENDIF
  96.                     pos:=pos+q
  97.                     IF src[pos]=","
  98.                         pos++                        -> skip ","
  99.                ENDIF
  100.                p++
  101.                     IF CtrlC() THEN RETURN
  102.             ENDWHILE
  103.                 pos++                                -> skip ")"
  104.                 pos++                                -> skip "("
  105.                 IF src[pos]<>")"
  106.                     next:=TRUE
  107.                     p:=0
  108.                     WHILE next
  109.                         IF Or(src[pos]="a",src[pos]="A") THEN VfPrintf(o,'a',NIL)
  110.                         IF Or(src[pos]="d",src[pos]="D") THEN VfPrintf(o,'d',NIL)
  111.                         IF And(Or(src[pos]="f",src[pos]="F"),Or(src[pos]="p",src[pos]="P")) THEN VfPrintf(o,'fp',NIL)
  112.                         pos++
  113.                         IF And(src[pos]>="0",src[pos]<="7") THEN VfPrintf(o,'\d',[Char(src+pos)-"0"])
  114.                         pos++
  115.                         q:=argtype[p]
  116.                         SELECT q
  117.                         CASE    T_PTR_TO_CHAR        ;    VfPrintf(o,':PTR TO CHAR',NIL)
  118.                         CASE    T_PTR_TO_TagItem    ;    VfPrintf(o,':PTR TO TagItem',NIL)
  119.                         ENDSELECT
  120.                         next:=IF Or(src[pos]=",",src[pos]="/") THEN TRUE ELSE FALSE
  121.                         IF next THEN VfPrintf(o,',',NIL)
  122.                         pos++
  123.                         p++
  124.                         IF CtrlC() THEN RETURN
  125. ->                        WriteF('\d\n',pos)
  126.                     ENDWHILE
  127.                 ENDIF
  128.                 VfPrintf(o,')(d0)=-\d',[offset])
  129.                 offset:=offset+6
  130.             ENDIF
  131.             pos:=xNextLine(src,pos,length)
  132.         ENDIF
  133.         IF CtrlC() THEN RETURN
  134.     ENDWHILE
  135.     VfPrintf(o,'\n',NIL)
  136. ENDPROC
  137.  
  138. PROC xNextLine(src:PTR TO CHAR,pos,length)
  139.     WHILE src[pos]<>"\n"
  140.         pos++
  141.     EXIT pos>length
  142.         IF CtrlC() THEN RETURN
  143.     ENDWHILE
  144. ENDPROC pos+1                                                        -> skip "\n"
  145.  
  146. PROC xWordLength(src:PTR TO CHAR,pos,length)
  147.     DEF l=0
  148.     WHILE xIsAlpha(src[pos])
  149.         l++
  150.         pos++
  151.     EXIT pos>length
  152.         IF CtrlC() THEN RETURN
  153.     ENDWHILE
  154. ENDPROC l
  155.  
  156. PROC xIsAlpha(c) IS IF Or(Or(Or(And(c>="A",c<="Z"),And(c>="a",c<="z")),And(c>="0",c<="9")),c="_") THEN TRUE ELSE FALSE
  157.